Final Project Big Data Bowl

MGSC 310 Problem Set Template

# Always print this out before your assignment
sessionInfo()

R version 4.1.1 (2021-08-10)
Platform: x86_64-apple-darwin17.0 (64-bit)
Running under: macOS Big Sur 11.5.2

Matrix products: default
LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] knitr_1.33

loaded via a namespace (and not attached):
 [1] compiler_4.1.1  here_1.0.1      fastmap_1.1.0   rprojroot_2.0.2 htmltools_0.5.2 tools_4.1.1     yaml_2.2.1      rmarkdown_2.10 
 [9] xfun_0.25       digest_0.6.27   rlang_0.4.12    evaluate_0.14  

getwd()

[1] "/Users/darron/Downloads"

# load all your libraries in this chunk 
library('dplyr')
library('tidyverse')
library('utils')
library('rsample')
library('glmnet')
library('glmnetUtils')
library('forcats')
library('rsample')
library('ggplot2')
library('sjPlot')
library('Publish')
library('data.table')
library('psych')
library('partykit')
library('PerformanceAnalytics')
library('rpart')
library('rpart.plot')
library('maptree')
library('randomForestExplainer')
library('rpart')
library('visNetwork')
library('caret')
library('ISLR')


# note, do not run install.packages() inside a code chunk. install them in the console outside of a code chunk. 

plays <- read.csv(here::here("Datasets", "plays.csv"))
pff <- read.csv(here::here("Datasets", "PFFscoutingdata.csv"))
head(pff)

NA

DF <- full_join(x = plays,
                 y = pff,
                 by = "gameId")

DF2 = select(DF, -5:-7, -10:-21, -25:-29, -32:-43)

DF2 %>% drop_na()

DF2$return_type[DF2$kickReturnYardage < 20] = "Short"
DF2$return_type[DF2$kickReturnYardage > 20 & DF2$kickReturnYardage < 50] = "Medium"
DF2$return_type[DF2$kickReturnYardage > 50] = "Long"

FinalDF <- data.frame(DF2, stringsAsFactors = TRUE) %>%
  drop_na() %>%
  mutate(return_type = as.factor(return_type),
         kickType = as.factor(kickType),
         kickContactType = as.factor(kickContactType))
head(FinalDF)

NA

summary(FinalDF)

     gameId              playId.x    playDescription       quarter      specialTeamsPlayType specialTeamsResult   kickLength   
 Min.   :2018090600   Min.   :  35   Length:41701       Min.   :1.000   Length:41701         Length:41701       Min.   : 2.00  
 1st Qu.:2018112508   1st Qu.: 886   Class :character   1st Qu.:1.000   Class :character     Class :character   1st Qu.:48.00  
 Median :2019102703   Median :1987   Mode  :character   Median :2.000   Mode  :character     Mode  :character   Median :56.00  
 Mean   :2019048212   Mean   :1986                      Mean   :2.444                                           Mean   :54.58  
 3rd Qu.:2020092712   3rd Qu.:2974                      3rd Qu.:3.000                                           3rd Qu.:63.00  
 Max.   :2021010315   Max.   :5456                      Max.   :5.000                                           Max.   :80.00  
                                                                                                                               
 kickReturnYardage   playResult        hangTime     kickType  kickContactType return_type   
 Min.   :-16.00    Min.   :-35.00   Min.   :1.220   A:12187   CC     :26944   Long  :13150  
 1st Qu.:  5.00    1st Qu.: 35.00   1st Qu.:4.080   N:29480   BF     : 7218   Medium:11483  
 Median : 14.00    Median : 41.00   Median :4.380   R:   34   BB     : 2119   Short :17068  
 Mean   : 15.08    Mean   : 40.18   Mean   :4.317             OOB    : 1937                 
 3rd Qu.: 23.00    3rd Qu.: 48.00   3rd Qu.:4.630             CFFG   : 1222                 
 Max.   :104.00    Max.   : 82.00   Max.   :5.690             MBDR   :  995                 
                                                              (Other): 1266                 

ggplot(data = FinalDF, aes(x = hangTime, y = kickLength)) + geom_point()

ggplot(data = FinalDF, aes(x = kickLength, y = kickReturnYardage)) + geom_point()

ggplot(data = FinalDF, aes(x = return_type)) + geom_bar()

df_split <- initial_split(FinalDF, prop = 0.75)
df_train <- training(df_split)
df_test <- testing(df_split)

dim(df_train)

[1] 31275    13

dim(df_test)

[1] 10426    13

mod1 <- lm(kickReturnYardage ~ kickLength + hangTime + kickContactType + playResult,
           data = df_train)

plot(x = predict(mod1), y = df_train$kickReturnYardage,
     xlab='Predicted Values',
     ylab='Actual Values',
     main='Predicted vs. Actual Values (Training Model)',
     col= 1)
abline(a = 0, b = 1)

print(mean((df_train$kickReturnYardage - predict(mod1))^2))

[1] 12.93302

plot(x = predict(mod1, newdata = df_test), y = df_test$kickReturnYardage,
     xlab='Predicted Values',
     ylab='Actual Values',
     main='Predicted vs. Actual Values (Testing Model)',
     col= 1)
abline(a = 0, b = 1)

print(mean((df_test$kickReturnYardage - predict(mod1))^2))

Warning in df_test$kickReturnYardage - predict(mod1) :
  longer object length is not a multiple of shorter object length

[1] 336.3096

#decision tree 1

#tree_mod_train <- ctree(return_type ~ kickLength + hangTime ,
    #                    data = df_train)



#print(tree_mod_train)
#plot(tree_mod_train) 
library('sparkline')


summary_mod_rpart <- rpart(return_type ~ kickLength + hangTime,
                           data = df_train,
                           method = "class",
                           control = list(cp = 0,
                                          minsplit = 10,
                                          maxdepth = 5))
summary_mod_rpart$cptable

            CP nsplit rel error    xerror        xstd
1 0.3887059332      0 1.0000000 1.0000000 0.004691750
2 0.0044539222      1 0.6112941 0.6112941 0.004588429
3 0.0035091508      3 0.6023862 0.6026022 0.004574035
4 0.0004049020      5 0.5953679 0.5954759 0.004561804
5 0.0001619608      7 0.5945581 0.5963397 0.004563308
6 0.0001079739      9 0.5942342 0.5966096 0.004563776
7 0.0000000000     11 0.5940182 0.5973115 0.004564992

plotcp(summary_mod_rpart)

2:16

 [1]  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16

visNetwork::visTree(summary_mod_rpart,
                    nodesPopSize = TRUE,
                    edgesFontSize = 18,
                    nodesFontSize = 20,
                    width = "100%",
                    height = "1200px")

NA
NA
NA

# Accuracy and other metrics
confusionMatrix(df_test$kickContactType, predictions2)

Confusion Matrix and Statistics

          Reference
Prediction   BB   BC   BF  BOG   CC CFFG  DEZ  ICC  KTB  KTC  KTF  MBC MBDR  OOB
      BB      6    0   18    0  471    5    0    0    0    0    0    0    0    0
      BC      0    1   10    0   40    0    0    0    0    0    0    0    0    0
      BF      7    1  224    0 1540   25    0    0    0    0    0    0    1    2
      BOG     0    0    1    0    9    0    0    0    0    0    0    0    0    0
      CC      4    0  140    0 6616   20    0    0    0    0    0    0    1    3
      CFFG    3    0   76    0  211   27    0    0    0    0    0    0    1    2
      DEZ     1    0    3    0  106    1    0    0    0    0    0    0    0    0
      ICC     0    0    0    0   32    0    0    0    0    0    0    0    0    0
      KTB     0    0    1    0   30    0    0    0    0    0    0    0    0    0
      KTC     0    0    1    0   61    0    0    0    0    0    0    0    0    0
      KTF     0    0    0    0   19    0    0    0    0    0    0    0    0    0
      MBC     1    0    1    0   11    0    0    0    0    0    0    0    0    0
      MBDR    0    0    5    0  231    1    0    0    0    0    0    0    0    0
      OOB     1    0   16    0  429    6    0    0    0    0    0    0    0    4

Overall Statistics
                                          
               Accuracy : 0.6597          
                 95% CI : (0.6505, 0.6688)
    No Information Rate : 0.9405          
    P-Value [Acc > NIR] : 1               
                                          
                  Kappa : 0.103           
                                          
 Mcnemar's Test P-Value : NA              

Statistics by Class:

                     Class: BB  Class: BC Class: BF Class: BOG Class: CC Class: CFFG Class: DEZ Class: ICC Class: KTB Class: KTC
Sensitivity          0.2608696 0.50000000   0.45161         NA    0.6747    0.317647         NA         NA         NA         NA
Specificity          0.9525137 0.99520338   0.84129  0.9990409    0.7290    0.971666    0.98935   0.996931   0.997027   0.994053
Pos Pred Value       0.0120000 0.01960784   0.12444         NA    0.9752    0.084375         NA         NA         NA         NA
Neg Pred Value       0.9982873 0.99990361   0.96847         NA    0.1241    0.994261         NA         NA         NA         NA
Prevalence           0.0022060 0.00019183   0.04757  0.0000000    0.9405    0.008153    0.00000   0.000000   0.000000   0.000000
Detection Rate       0.0005755 0.00009591   0.02148  0.0000000    0.6346    0.002590    0.00000   0.000000   0.000000   0.000000
Detection Prevalence 0.0479570 0.00489162   0.17265  0.0009591    0.6507    0.030692    0.01065   0.003069   0.002973   0.005947
Balanced Accuracy    0.6066916 0.74760169   0.64645         NA    0.7019    0.644657         NA         NA         NA         NA
                     Class: KTF Class: MBC Class: MBDR Class: OOB
Sensitivity                  NA         NA   0.0000000  0.3636364
Specificity            0.998178   0.998753   0.9772618  0.9566011
Pos Pred Value               NA         NA   0.0000000  0.0087719
Neg Pred Value               NA         NA   0.9997056  0.9992979
Prevalence             0.000000   0.000000   0.0002877  0.0010551
Detection Rate         0.000000   0.000000   0.0000000  0.0003837
Detection Prevalence   0.001822   0.001247   0.0227316  0.0437368
Balanced Accuracy            NA         NA   0.4886309  0.6601187